Alles Voor Internet / Tout Pour Internet/alles voor internet.iso/MacInternet™/Modem/S&D III/Scanner.p

Text File | 1993-06-30 | 38.1 KB | 1,299 lines | [TEXT/PJMM]

program Scanner;

{    This code was written in THINK Pascal 4 on a MacQuadra 950 - caches on too!                }
{    You may use this code for whatever on the following conditions;                            }
{        1.    You may not use it for any program (in whole or part) for you you will charge        }
{        2.    You must include this code (with header & my details) when distributing            }
{        3.    You must include the following message in your about box                            }
{                                                                                                        }
{                    'serial code by Boris ([e-mail])                                }
{                                                                                                        }
{        4.    You must feel really guilty if you don't send me a copy of your application            }
{            (source code too would be nice...for my interest only, NOT to rip you off            }
{                                                                                                        }
{    Well, now onto the disclaimer bit...                                                                }
{    I take no responsibility for any damage that this code may cause cuz it works fine        }
{    for me and I've used it a lot with several applications running and it never did me            }
{    any harm.  Use at your own risk, do regular exercise, always use a condom, be nice        }
{    eat fruit, everybody knows what is meant in this bit and in a court of law I reckon        }
{    its pretty bloody obvious what is meant by this bit so I'll shut my banter and leave        }
{    you people to paw over this lovely piece of code where elegance is something that        }
{    happens to other people (except MicroSoft! - dodgy is the keyword there).                    }
{                                                                                                        }
{    I don't expect any payment for this code.  It is free!!!  Give it to anyone!  Use it.            }
{    Please don't rip off my code, or anyone else's, cuz that just makes you a sad bastard    .    }
{    I put a lot of work into this, and I'm giving away many hours work to save you the        }
{    effort.                                                                                                }
{                                                                                                        }
{    Feel free to mail me with any questions you have about this, or anything else.                }
{    I reply to everything.                                                                            }
{                                                                                                        }
{    [e-mail]  (IP. 158.152.11.47)                                                }

    uses
        Serial;                            {include standard Serial.p library}

    const
        ModemInput = '.AIn';            {driver name.  Use .BIn for printer port}
        ModemOutput = '.AOut';        {driver name.  Use .BOut for printer port}

        myMenuBarID = 131;

        myAlertID = 128;
        myPhoneNumberAlertID = 132;
        myTimeErrorAlertID = 133;

        myAboutDialogID = 129;
        myPhoneNumberDialogID = 130;
        myPrefsDialogID = 131;

        myMainWindowID = 128;
        myStatusWindowID = 129;

        myAboutMenuID = 128;
        myFileMenuID = 129;
        myOptionsMenuID = 130;

        delayTime = 180;        {3 second wait after dialing}
        hangUpDelay = 120;        {2 second delay between +++ and ATH0}


    type
        StatusType = (idle, dialing, waiting, hangingUp);

    var
        Active, Quit, Silent, BeepOnModem, BeepOnStart, BeepOnFinish, OffHook: boolean;
        InShake, OutShake: SerShk;
        Redials, ModemBaud, ModemStop, ModemParity, ModemData, ReceiveDriverRefNum, SendDriverRefNum: integer;
        maxRedials, maxWaitTime, TotalModems, TotalBusy, TotalNoAnswer, TotalErrors, TotalCalls: integer;
        Prefix: str255;
        CurrentNumber, EndNumber, StartNumber, Timer: longint;
        ResultsFilename, StartTime, StopTime: str255;
        MenuBarHandle: handle;
        SendBuffer, ReceiveBuffer: array[1..1000] of byte;
        MainWindow: WindowPtr;
        myEventRecord: EventRecord;
        Status: StatusType;
        myStopButton, myStartButton: ControlHandle;
        StartButtonBox, StopButtonBox: rect;
        ResultsFile: text;

    procedure doError (theError: integer);            {I prefer to have error strings and the like in the main code}
        var                                                    {rather than storing then in string resources}
            ErrorMessage, ErrorNumberString: str255;    {saves me having to have ResEdit open at the same time}
    begin                                                    {I mean, I only have a 19" monitor}
        case theError of
            1:
                ErrorMessage := 'The menu bar resources could not be found';
            2:
                ErrorMessage := 'Memory allocation for window storage failed';
            3:
                ErrorMessage := 'Unable to show ''About...'' dialog';
            4:
                ErrorMessage := 'Menu selection error';
            5:
                ErrorMessage := 'Unable to show ''Phone number...'' dialog';
            6:
                ErrorMessage := 'Unable to create controls';
            7:
                ErrorMessage := 'Failed to write to serial driver';
            8:
                ErrorMessage := 'Failed to read from serial driver';
            9:
                ErrorMessage := 'The phone is not connected or being used';
            10:
                ErrorMessage := 'An error occurred whilst opening the serial drivers';
            11:
                ErrorMessage := 'Failed to close serial drivers';
            12:
                ErrorMessage := 'Failed to create the results file';
            13:
                ErrorMessage := 'Failed to open the new results file';
            14:
                ErrorMessage := 'Failed to write to results file';
            15:
                ErrorMessage := 'Failed to close results file';
            otherwise
                ErrorMessage := 'UNDEFINED ERROR';
        end;
        NumToString(theError, ErrorNumberString);
        ParamText(ErrorNumberString, ErrorMessage, '', '');
        theError := Alert(myAlertID, nil);
    end;

    function StringCompare (String1, String2: str255): boolean;
        var
            loop: integer;
    begin
        StringCompare := EqualString(String1, String2, false, false);
    end;

{-------------------------------------- Initialise -----------------------------------------}

    function SetupMenuBar: boolean;
    begin
        MenuBarHandle := GetNewMBar(myMenuBarID);
        if MenuBarHandle = nil then
            SetupMenuBar := false
        else
            begin
                HLock(MenuBarHandle);
                SetMenuBar(MenuBarHandle);
                SetMenuFlash(2);
                DrawMenuBar;
                SetupMenuBar := true;
            end;
    end;

    procedure KillMenuBar;
    begin
        if MenuBarHandle <> nil then
            begin
                HUnlock(MenuBarHandle);
                DisposHandle(MenuBarHandle);
            end;
    end;

    function SetupWindows: boolean;
    begin
        MainWindow := GetNewWindow(myMainWindowID, nil, pointer(-1));
        if MainWindow = nil then
            SetupWindows := false                                                        {I do my own button drawing/handling}
        else
            begin
                myStartButton := NewControl(MainWindow, StartButtonBox, 'Start', true, 0, 0, 1, pushButProc, 1);
                myStopButton := NewControl(MainWindow, StopButtonBox, 'Stop', true, 0, 0, 1, pushButProc, 2);
                if (myStartButton = nil) or (myStopButton = nil) then
                    begin
                        doError(6);
                        SetupWindows := false;
                    end
                else
                    begin
                        HLock(handle(myStartButton));
                        HLock(handle(myStopButton));
                        SetupWindows := true;
                    end;
            end;
    end;

    procedure KillWindows;
    begin
        if myStartButton <> nil then
            begin
                HUnlock(handle(myStartButton));
                DisposeControl(myStartButton);
            end;
        if myStopButton <> nil then
            begin
                HUnlock(handle(myStopButton));
                DisposeControl(myStopButton);
            end;
        if MainWindow <> nil then
            DisposeWindow(MainWIndow);
    end;

    procedure InitialiseVars;
    begin
        ModemBaud := baud2400;
        ModemStop := stop10;
        ModemParity := noParity;
        ModemData := data8;
        Prefix := '';
        CurrentNumber := 0;
        StartNumber := 0;
        EndNumber := 0;
        TotalModems := 0;
        TotalBusy := 0;
        TotalNoAnswer := 0;
        TotalErrors := 0;
        TotalCalls := 0;
        BeepOnModem := true;
        BeepOnStart := true;
        BeepOnFinish := true;
        OffHook := false;
        StartTime := '00:00';
        StopTime := '00:00';
        ResultsFilename := 'Seek & Destroy III Results';
        SetRect(StartButtonBox, 25, 220, 95, 240);
        SetRect(StopButtonBox, 100, 220, 170, 240);
        Redials := 0;
        maxRedials := 3;
        maxWaitTime := 30;
        Silent := false;
        Active := false;
        Quit := false;
    end;

{---------------------------------------- Serial setup ------------------------------------}
    procedure CloseDrivers;
        var
            Error: OSErr;
            problem: boolean;
    begin
        problem := false;
        Error := CloseDriver(ReceiveDriverRefNum);
        if Error <> noErr then
            problem := true;
        Error := CloseDriver(SendDriverRefNum);
        if Error <> noErr then
            problem := true;
        if problem then
            doError(11);                                                {••• These are pretty much the standard serial}
    end;                                                                {routines I use for doing modemy type stuff}
                                                                    {They're tried and tested and work well}
    procedure SetupDrivers;
        var
            myErr: OSErr;
            problem: boolean;
    begin
        problem := false;
        myErr := OpenDriver(ModemInput, ReceiveDriverRefNum);                            {setup serial drivers}
        if myErr <> noErr then
            problem := true;
        myErr := OpenDriver(ModemOutput, SendDriverRefNum);
        if myErr <> noErr then
            problem := true;
        if not (problem) then
            begin
                myErr := SerSetBuf(ReceiveDriverRefNum, @ReceiveBuffer, 4096);
                if myErr <> noErr then
                    problem := true;
                myErr := SerSetBuf(SendDriverRefNum, @SendBuffer, 4096);
                if myErr <> noErr then
                    problem := true;
                if not (problem) then
                    begin
                        myErr := SerReset(ReceiveDriverRefNum, ModemBaud + ModemStop + ModemParity + ModemData);
                        if myErr <> noErr then
                            problem := true;
                        myErr := SerReset(SendDriverRefNum, ModemBaud + ModemStop + ModemParity + ModemData);
                        if myErr <> noErr then
                            problem := true;
                        if not (problem) then
                            begin
                                with InShake do    {Volume IV of SpInsideMac additions}
                                    begin
                                        fXOn := 0;  {XOn/XOff is off}
                                        fCTS := 0;  {hardware CTS handshaking off}
                                        xOn := chr(19);  {control-s}
                                        xOff := chr(17);  {control-q}
                                        errs := parityErr + hwOverrunErr + framingErr;  {busts if these errs happen}
                                        evts := ctsEvent + breakEvent;  {sends driver events if these things happen}
                                        fInX := 0;  {Xon/off input control flow flag}
                                        fDtr := 0;  {useful}
                                    end;
                                OutShake := InShake;
                                myErr := SerHShake(ReceiveDriverRefNum, InShake);
                                if myErr <> noErr then
                                    problem := true;
                                myErr := SerHShake(SendDriverRefNum, OutShake);
                                if myErr <> noErr then
                                    problem := true;
                            end;
                    end;
            end;
        if problem then
            doError(10);
    end;

{------------------------------------ Get from Serial port ------------------------------------------}

    procedure OutChar (TheChar: char);
        var
            StringLength: longint;
            myErr: OSErr;
    begin
        StringLength := 1;
        myErr := FSWrite(SendDriverRefNum, StringLength, ptr(ord(@TheChar) + 1));
        if myErr <> noErr then
            doError(7);
    end;

    procedure OutString (TheString: str255);            {tacky way of doing it, but effective}
        var                                                    {could just dump the whole string but this way I}
            loop: integer;                                        {can detect the error at character level}
    begin                                                    {rather than being told that the string couldn't be}
        for loop := 1 to length(TheString) do                {sent...this way I know how far it got}
            begin
                OutChar(TheString[loop]);                        {Anyway, I've been using this routine for years}
            end;
    end;

    procedure InChar (var TheChar: char);            {Get a char.  If none available then returns null chr(0)}
        var
            StringPtr: ptr;
            StringLength: longint;
            TheString: str255;
            myErr: OSErr;
    begin
        myErr := SerGetBuf(ReceiveDriverRefNum, StringLength);
        TheString := 'z';
        if StringLength > 0 then
            begin
                StringLength := 1;
                myErr := FSRead(ReceiveDriverRefNum, StringLength, ptr(ord(@TheString) + 1));
                TheChar := TheString[1];
                if myErr <> noErr then
                    doError(8);
            end
        else
            begin
                TheChar := chr(0);
            end;
    end;

    procedure InString (var TheString: str255);
        var
            StringPtr: ptr;
            StringLength: longint;
            TheChar: char;
            myErr: OSErr;
    begin
        TheString := '';
        TheChar := chr(0);
        InChar(TheChar);
        case TheChar of
            'C':                                     {CONNECT message}
                begin
                    StringLength := 6;
                    myErr := FSRead(ReceiveDriverRefNum, StringLength, ptr(ord(@TheString) + 1));
                    StringPtr := @TheString;
                    StringPtr^ := StringLength;
                end;
            'N':                                     {NO ANSWER message}
                begin
                    StringLength := 9;
                    myErr := FSRead(ReceiveDriverRefNum, StringLength, ptr(ord(@TheString) + 1));
                    StringPtr := @TheString;
                    StringPtr^ := StringLength;
                end;
            'B':                                     {BUSY message}
                begin
                    StringLength := 3;
                    myErr := FSRead(ReceiveDriverRefNum, StringLength, ptr(ord(@TheString) + 1));
                    StringPtr := @TheString;
                    StringPtr^ := StringLength;
                end;
            'E':                                     {ERROR message}
                begin
                    StringLength := 4;
                    myErr := FSRead(ReceiveDriverRefNum, StringLength, ptr(ord(@TheString) + 1));
                    StringPtr := @TheString;
                    StringPtr^ := StringLength;
                end;
            otherwise
                begin
                    TheString := 'dum dee doo';
                end;
        end;
    end;

    procedure ClearInputBuffer;
        var
            DummyChar: char;
    begin
        DummyChar := 'a';
        while DummyChar <> chr(0) do        {Not th best way to do this...better off reading until}
            begin                                    {buffer length is zero...so far, though, its worked fine}
                InChar(DummyChar);                    {and its been used a lot}
            end;
    end;

{--------------------------------------- Draw Screen ------------------------------------------}

    procedure DrawInfo (Heading, info: str255);
    begin
        TextFace([bold]);
        DrawString(Heading);
        TextFace([]);
        DrawString(info);
    end;

    function CleanNumber (theNum: longint): str255;        {strips off leading spaces}
        var
            theString: str255;
    begin
        NumToString(theNum, theString);
        while theString[1] = ' ' do
            delete(theString, 1, 1);
        CleanNumber := theString;
    end;

    procedure DrawMainWindow;
        var
            tempString: str255;
    begin
        SetPort(MainWindow);
        SelectWindow(MainWindow);
        EraseRect(MainWindow^.portRect);
        MoveTo(10, 25);
        TextFace([Bold] + [outline]);
        TextFont(helvetica);
        TextSize(24);
        DrawString('BorMak Tech');
        MoveTo(15, 47);
        TextFace([Bold]);
        TextFont(times);
        TextSize(18);
        DrawString('  Seek & Destroy III');
        MoveTo(10, 70);
        TextFace([bold]);
        TextFont(geneva);
        TextSize(9);
        case Status of
            idle:
                DrawInfo('Status:', 'Idle');
            dialing:
                DrawInfo('Status:', 'Dialing...');
            waiting:
                DrawInfo('Status:', 'Waiting...');
            hangingUp:
                DrawInfo('Status:', 'Hanging up...');
            otherwise
                DrawInfo('Error', '');
        end;
        MoveTo(10, 85);
        TempString := CleanNumber(CurrentNumber);
        DrawInfo('Number:', concat('   ', Prefix, '  ', TempString));
        MoveTo(10, 100);
        TempString := CleanNumber(TotalModems);
        DrawInfo('Modems:', TempString);
        MoveTo(10, 115);
        TempString := CleanNumber(TotalBusy);
        DrawInfo('Busy:', TempString);
        MoveTo(10, 130);
        TempString := CleanNumber(TotalNoAnswer);
        DrawInfo('No answer:', TempString);
        MoveTo(10, 145);
        TempString := CleanNumber(TotalErrors);
        DrawInfo('Errors:', TempString);
        MoveTo(10, 160);
        TempString := CleanNumber(TotalCalls);
        DrawInfo('Calls:', TempString);
        MoveTo(10, 180);
        DrawInfo('Start time:', StartTime);
        MoveTo(10, 195);
        DrawInfo('Stop time:', StopTime);
        DrawControls(MainWindow);
        MoveTo(370, 245);
        DrawInfo('', 'Boris');                    {leave this in, please...give me SOME credit!}
    end;

    procedure ShowAboutWindow;            {Don't forget...if you use any of my code, include my name&address}
        var                                        {in your about box}
            MyDialogPtr: DialogPtr;
            TheItem: integer;
    begin
        MyDialogPtr := GetNewDialog(myAboutDialogID, nil, pointer(-1));
        if MyDialogPtr = nil then
            doError(3)
        else
            begin
                ModalDialog(nil, TheItem);
                DisposDialog(MyDialogPtr);
            end;
    end;

{------------------------------- Selections ---------------------------}
    procedure DumpToFile (messageString: str255);
        var
            tempString, timeString, dateString: str255;
            currentTime: longint;
    begin
        GetDateTime(currentTime);
        IUTimeString(currentTime, true, timeString);
        IUDateString(currentTime, longDate, dateString);
        NumToString(currentNumber, tempString);
        writeln(ResultsFile, messageString, '    ', Prefix, '  ', tempString, '    ', timeString, ' on ', dateString);
    end;

    procedure OpenResultsFile (theFilename: str255);        {Could always do it properly but using the}
    begin                                                            {standard pascal commands is Sooooooo much easier}
        Rewrite(ResultsFile, theFilename);
    end;

    procedure CloseResultFile;
        var
            tempString, timeString, dateString: str255;
            currentTime: longint;
    begin
        GetDateTime(currentTime);
        IUTimeString(currentTime, true, timeString);
        IUDateString(currentTime, longDate, dateString);
        writeln(ResultsFile, '');
        writeln(ResultsFile, '========================================================');
        writeln(ResultsFile, 'Result file closed at ', timeString, ' on ', dateString);
        NumToString(currentNumber, tempString);
        writeln(ResultsFile, 'Current number:', Prefix, '  ', tempString);
        Close(ResultsFile);
    end;

    procedure DumpHeader;
        var
            timeString, dateString: str255;
            currentTime: longint;
    begin
        GetDateTime(currentTime);
        IUTimeString(currentTime, true, timeString);
        IUDateString(currentTime, longDate, dateString);
        writeln(ResultsFile, 'BorMak Tech  Seek & Destroy III Results File');
        writeln(ResultsFile, 'Results file created at ', timeString, ' on ', dateString);
        writeln(ResultsFile, '========================================================');
        writeln(ResultsFile, '');
    end;

    function GetFilename (closeFirst: boolean): boolean;
    begin
        ResultsFilename := newfilename('Put results where?', 'Seek & Destroy III Results');
        if ResultsFilename = '' then
            GetFilename := false
        else
            begin
                if closeFirst then
                    CloseResultFile;
                rewrite(ResultsFile, ResultsFilename);
                DumpHeader;
                GetFilename := true;
            end;
    end;

    procedure SelectPhoneNumber;
        var
            myDialog: DialogPtr;
            finished: boolean;
            itemHandle: handle;
            tempString: str255;
            itemRect: rect;
            itemType, theItem: integer;
            newNumber: longint;
    begin
        myDialog := GetNewDialog(myPhoneNumberDialogID, nil, pointer(-1));
        if myDialog = nil then
            doError(5)
        else
            begin
                NumToString(currentNumber, tempString);
                GetDItem(myDialog, 4, itemType, itemHandle, itemRect);
                SetIText(itemHandle, tempString);
                GetDItem(myDialog, 3, itemType, itemHandle, itemRect);
                SetIText(itemHandle, Prefix);
                DrawDialog(myDialog);
                finished := false;
                while not (finished) do
                    begin
                        ModalDialog(nil, theItem);
                        if theItem = 1 then
                            begin
                                GetDItem(myDialog, 4, itemType, itemHandle, itemRect);
                                GetIText(itemHandle, tempString);
                                StringToNum(tempString, newNumber);
                                if newNumber < 0 then
                                    begin
                                        theItem := Alert(myPhoneNumberAlertID, nil);
                                        SelIText(myDialog, 4, 0, 255);
                                    end
                                else
                                    begin
                                        GetDItem(myDialog, 4, itemType, itemHandle, itemRect);
                                        GetIText(itemHandle, tempString);
                                        StringToNum(tempString, newNumber);
                                        GetDItem(myDialog, 3, itemType, itemHandle, itemRect);
                                        GetIText(itemHandle, Prefix);
                                        finished := true;
                                    end;
                            end
                        else if theItem = 2 then
                            Finished := true;
                    end;
                CurrentNumber := newNumber;
                DisposDialog(myDialog);
            end;
    end;

    function TimeValid (theTime: str255): boolean;
        var
            Result: boolean;
            tempString: str255;                            {this routine is TACKY but works}
            tempNum: longint;
    begin
        Result := true;
        if length(theTime) <> 5 then
            Result := false
        else if theTime[3] <> ':' then
            Result := false
        else
            begin
                tempString := copy(theTime, 1, 2);
                StringToNum(tempString, tempNum);
                if (tempNum < 0) or (tempNum > 23) then
                    Result := false
                else
                    begin
                        tempString := copy(theTime, 4, 2);
                        StringToNum(tempString, tempNum);
                        if (tempNum < 0) or (TempNum > 59) then
                            Result := false;
                    end;
            end;
        TimeValid := Result;
    end;

    function GetSelectedControl (theDialog: dialogPtr; first, last: integer): integer;
        var
            loop, theType: integer;
            itemRect: rect;
            itemHandle: handle;
            gottit: boolean;
    begin
        loop := first - 1;
        gottit := false;
        repeat
            loop := loop + 1;
            GetDItem(theDialog, loop, theType, itemHandle, itemRect);
            if GetCtlValue(ControlHandle(itemHandle)) > 0 then
                gottit := true;
        until (GetCtlValue(ControlHandle(itemHandle)) > 0) or (loop = last);
        if gottit then
            GetSelectedControl := loop
        else
            GetSelectedControl := 0;
    end;

    procedure SelectPrefs;                    {there HAS to be a better way of doing this stuff}
        var                                        {so far it eludes me but I'm happy doing it like this for the moment}
            myDialog: dialogPtr;
            loop, theItem, theType: integer;
            tempLong: longint;
            itemRect: rect;
            itemHandle: handle;
            finished: boolean;
            theEvent: eventRecord;
            tempString: str255;
    begin
        myDialog := GetNewDialog(myPrefsDialogID, nil, pointer(-1));
        if myDialog = nil then
            doError(5)
        else
            begin
                for loop := 3 to 26 do
                    begin
                        GetDItem(myDialog, loop, theType, itemHandle, itemRect);
                        SetCtlValue(ControlHandle(itemHandle), 0);
                    end;
                case ModemBaud of
                    baud300:
                        theItem := 13;
                    baud600:
                        theItem := 12;
                    baud1200:
                        theItem := 11;
                    baud1800:
                        theItem := 10;
                    baud2400:
                        theItem := 9;
                    baud3600:
                        theItem := 8;
                    baud4800:
                        theItem := 7;
                    baud7200:
                        theItem := 6;
                    baud9600:
                        theItem := 5;
                    baud19200:
                        theItem := 4;
                    baud57600:
                        theItem := 3;
                    otherwise
                        theItem := 3;
                end;
                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                SetCtlValue(ControlHandle(itemHandle), 1);
                case ModemStop of
                    stop10:
                        theItem := 14;
                    stop20:
                        theItem := 16;
                    otherwise
                        theItem := 15;    {stop15 - invalid for case statement value= -32768}
                end;
                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                SetCtlValue(ControlHandle(itemHandle), 1);
                case ModemParity of
                    noParity:
                        theItem := 17;
                    oddParity:
                        theItem := 18;
                    evenParity:
                        theItem := 19;
                    otherwise
                        theItem := 17;
                end;
                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                SetCtlValue(ControlHandle(itemHandle), 1);
                case ModemData of
                    0:
                        theItem := 20;
                    2048:
                        theItem := 21;
                    1024:
                        theItem := 22;
                    3072:
                        theItem := 23;
                    otherwise
                        theItem := 23;
                end;
                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                SetCtlValue(ControlHandle(itemHandle), 1);
                if BeepOnModem then
                    begin
                        GetDItem(myDialog, 24, theType, itemHandle, itemRect);
                        SetCtlValue(ControlHandle(itemHandle), 1);
                    end;
                if BeepOnStart then
                    begin
                        GetDItem(myDialog, 25, theType, itemHandle, itemRect);
                        SetCtlValue(ControlHandle(itemHandle), 1);
                    end;
                if BeepOnFinish then
                    begin
                        GetDItem(myDialog, 26, theType, itemHandle, itemRect);
                        SetCtlValue(ControlHandle(itemHandle), 1);
                    end;
                GetDItem(myDialog, 40, theType, itemHandle, itemRect);
                if Silent then
                    SetCtlValue(ControlHandle(itemHandle), 1)
                else
                    SetCtlValue(ControlHandle(itemHandle), 0);
                GetDItem(myDialog, 27, theType, itemHandle, itemRect);
                SetIText(itemHandle, StartTime);
                GetDItem(myDialog, 28, theType, itemHandle, itemRect);
                SetIText(itemHandle, StopTime);
                NumToString(maxRedials, tempString);
                GetDItem(myDialog, 37, theType, itemHandle, itemRect);
                SetIText(itemHandle, tempString);
                NumToString(maxWaitTime, tempString);
                GetDItem(myDialog, 39, theType, itemHandle, itemRect);
                SetIText(itemHandle, tempString);
                DrawDialog(myDialog);
                finished := false;
                while not (finished) do
                    begin
                        repeat
                        until GetNextEvent(everyEvent, theEvent);
                        if IsDialogEvent(theEvent) then
                            if DialogSelect(theEvent, myDialog, theItem) then
                                begin
                                    case theItem of
                                        1:
                                            begin
                                                GetDItem(myDialog, 27, theType, itemHandle, itemRect);
                                                GetIText(itemHandle, tempString);
                                                if not (TimeValid(tempString)) then
                                                    begin
                                                        loop := Alert(myTimeErrorAlertID, nil);
                                                        SelIText(myDialog, 27, 0, 255);
                                                    end
                                                else
                                                    begin
                                                        GetDItem(myDialog, 28, theType, itemHandle, itemRect);
                                                        GetIText(itemHandle, tempString);
                                                        if not (TimeValid(tempString)) then
                                                            begin
                                                                loop := Alert(myTimeErrorAlertID, nil);
                                                                SelIText(myDialog, 28, 0, 255);
                                                            end
                                                        else
                                                            begin
                                                                theItem := GetSelectedControl(myDialog, 3, 13);
                                                                case theItem of
                                                                    3:
                                                                        ModemBaud := baud57600;
                                                                    4:
                                                                        ModemBaud := baud19200;
                                                                    5:
                                                                        ModemBaud := baud9600;
                                                                    6:
                                                                        ModemBaud := baud7200;
                                                                    7:
                                                                        ModemBaud := baud4800;
                                                                    8:
                                                                        ModemBaud := baud3600;
                                                                    9:
                                                                        ModemBaud := baud2400;
                                                                    10:
                                                                        ModemBaud := baud1800;
                                                                    11:
                                                                        ModemBaud := baud1200;
                                                                    12:
                                                                        ModemBaud := baud600;
                                                                    13:
                                                                        ModemBaud := baud300;
                                                                    otherwise
                                                                end;
                                                                theItem := GetSelectedControl(myDialog, 14, 16);
                                                                case theItem of
                                                                    14:
                                                                        ModemStop := stop10;
                                                                    15:
                                                                        ModemStop := stop15;
                                                                    16:
                                                                        ModemStop := stop20;
                                                                    otherwise
                                                                end;
                                                                theItem := GetSelectedControl(myDialog, 17, 19);
                                                                case theItem of
                                                                    17:
                                                                        ModemParity := noParity;
                                                                    18:
                                                                        ModemParity := oddParity;
                                                                    19:
                                                                        ModemParity := evenParity;
                                                                    otherwise
                                                                end;
                                                                theItem := GetSelectedControl(myDialog, 20, 23);
                                                                case theItem of
                                                                    20:
                                                                        ModemData := data5;
                                                                    21:
                                                                        ModemData := data6;
                                                                    22:
                                                                        ModemData := data7;
                                                                    23:
                                                                        ModemData := data8;
                                                                    otherwise
                                                                end;
                                                                GetDItem(myDialog, 24, theType, itemHandle, itemRect);
                                                                if GetCtlValue(ControlHandle(itemHandle)) > 0 then
                                                                    BeepOnModem := true
                                                                else
                                                                    BeepOnModem := false;
                                                                GetDItem(myDialog, 25, theType, itemHandle, itemRect);
                                                                if GetCtlValue(ControlHandle(itemHandle)) > 0 then
                                                                    BeepOnStart := true
                                                                else
                                                                    BeepOnStart := false;
                                                                GetDItem(myDialog, 26, theType, itemHandle, itemRect);
                                                                if GetCtlValue(ControlHandle(itemHandle)) > 0 then
                                                                    BeepOnFinish := true
                                                                else
                                                                    BeepOnFinish := false;
                                                                GetDItem(myDialog, 40, theType, itemHandle, itemRect);
                                                                if GetCtlValue(ControlHandle(itemHandle)) > 0 then
                                                                    Silent := true
                                                                else
                                                                    Silent := false;
                                                                GetDItem(myDialog, 27, theType, itemHandle, itemRect);
                                                                GetIText(itemHandle, StartTime);
                                                                GetDItem(myDialog, 28, theType, itemHandle, itemRect);
                                                                GetIText(itemHandle, StopTime);
                                                                GetDItem(myDialog, 37, theType, itemHandle, itemRect);
                                                                GetIText(itemHandle, tempString);
                                                                StringToNum(tempString, tempLong);
                                                                maxRedials := LoWord(tempLong);
                                                                GetDItem(myDialog, 39, theType, itemHandle, itemRect);
                                                                GetIText(itemHandle, tempString);
                                                                StringToNum(tempString, tempLong);
                                                                maxWaitTime := LoWord(tempLong);
                                                                CloseDrivers;
                                                                SetupDrivers;
                                                                finished := true;
                                                            end;
                                                    end;
                                            end;
                                        2:
                                            finished := true;
                                        3..13:
                                            begin
                                                for loop := 3 to 13 do
                                                    begin
                                                        GetDItem(myDialog, loop, theType, itemHandle, itemRect);
                                                        SetCtlValue(ControlHandle(itemHandle), 0);
                                                    end;
                                                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                                                SetCtlValue(ControlHandle(itemHandle), 1);
                                            end;
                                        14..16:
                                            begin
                                                for loop := 14 to 16 do
                                                    begin
                                                        GetDItem(myDialog, loop, theType, itemHandle, itemRect);
                                                        SetCtlValue(ControlHandle(itemHandle), 0);
                                                    end;
                                                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                                                SetCtlValue(ControlHandle(itemHandle), 1);
                                            end;
                                        17..19:
                                            begin
                                                for loop := 17 to 19 do
                                                    begin
                                                        GetDItem(myDialog, loop, theType, itemHandle, itemRect);
                                                        SetCtlValue(ControlHandle(itemHandle), 0);
                                                    end;
                                                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                                                SetCtlValue(ControlHandle(itemHandle), 1);
                                            end;
                                        20..23:
                                            begin
                                                for loop := 20 to 23 do
                                                    begin
                                                        GetDItem(myDialog, loop, theType, itemHandle, itemRect);
                                                        SetCtlValue(ControlHandle(itemHandle), 0);
                                                    end;
                                                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                                                SetCtlValue(ControlHandle(itemHandle), 1);
                                            end;
                                        24..26:
                                            begin
                                                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                                                if GetCtlValue(ControlHandle(itemHandle)) > 0 then
                                                    loop := 0
                                                else
                                                    loop := 1;
                                                SetCtlValue(ControlHandle(itemHandle), loop);
                                            end;
                                        40:
                                            begin
                                                GetDItem(myDialog, theItem, theType, itemHandle, itemRect);
                                                if GetCtlValue(ControlHandle(itemHandle)) > 0 then
                                                    loop := 0
                                                else
                                                    loop := 1;
                                                SetCtlValue(ControlHandle(itemHandle), loop);
                                            end;
                                        otherwise
                                    end;
                                end;
                    end;
                DisposDialog(myDialog);                    {phew!  Long routine to do something so simple}
            end;
    end;

    procedure HangUp;                            {last time I wrote this routine I just closed the drivers}
        var                                            {then opened them again.  Works very well!}
            dummy: longint;                            {Thought I'd be cleaner this time}
    begin                                            {I did find, however, that the Teleport modem didn't work well}
        if OffHook then                                {with this ATH business...dunno why}
            begin
                Status := hangingUp;
                DrawMainWindow;
                OutString('+++');
                Delay(hangUpDelay, dummy);
                OutString(concat('ATZ', chr(13)));
                Delay(hangUpDelay, dummy);
                OutString(concat('ATH', chr(13)));
                CloseDrivers;
                SetupDrivers;
                ClearInputBuffer;
            end;
        OffHook := false;
    end;

    procedure CheckTimer;
        var
            CurrentTime: longint;
            tempString: str255;
    begin
        if not (EqualString(StartTime, StopTime, false, false)) then
            begin
                GetDateTime(CurrentTime);
                IUTimeString(currentTime, false, tempString);
                if Active then
                    begin
                        if EqualString(tempString, StopTime, false, false) then
                            if Status = dialing then
                                begin
                                    Active := false;
                                    if BeepOnFinish then
                                        SysBeep(1);
                                    HangUp;
                                    Status := idle;
                                    DrawMainWindow;
                                end;
                    end
                else
                    begin
                        if EqualString(tempString, StartTime, false, false) then
                            begin
                                Status := dialing;
                                DrawMainWindow;
                                if BeepOnStart then
                                    SysBeep(1);
                                Active := true;
                            end;
                    end
            end;
    end;

    procedure DialNumber;
        var
            tempString: str255;
            dummy: longint;
    begin
        OffHook := true;
        NumToString(currentNumber, tempString);
        ClearInputBuffer;
        OutString(concat('ATZ', chr(13)));
        Delay(60, dummy);
        if Silent then
            OutString(concat('ATM0', chr(13)))                {turns the modem speaker off if it has one}
        else
            OutString(concat('ATM2', chr(13)));
        Delay(60, dummy);
        OutString(concat('ATDT ', prefix, tempString, chr(13)));
        Delay(delayTime, dummy);
        TotalCalls := TotalCalls + 1;
        Status := waiting;
        DrawMainWindow;
        GetDateTime(Timer);
    end;

    procedure NextNumber;
    begin
        HangUp;
        currentNumber := currentNumber + 1;
        Status := dialing;
        DrawMainWindow;
    end;

    function TimedOut: boolean;
        var
            timeNow: longint;
    begin
        GetDateTime(timeNow);
        if timeNow - Timer > maxWaitTime then
            TimedOut := true
        else
            TimedOut := false;
    end;

    procedure DoSerial;
        var
            fromModem: str255;
    begin
        if not (TimedOut) then
            begin
                InString(fromModem);
                if StringCompare(fromModem, 'ONNECT') = true then
                    begin
                        TotalModems := TotalModems + 1;
                        if BeepOnModem then
                            SysBeep(1);
                        DumpToFile('Modem found');
                        NextNumber;
                    end
                else if StringCompare(fromModem, 'O CARRIER') = true then
                    begin
                        NextNumber;
                    end
                else if StringCompare(fromModem, 'O ANSWER') = true then
                    begin
                        TotalNoAnswer := TotalNoAnswer + 1;
                        DumpToFile('No answer');
                        NextNumber;
                    end
                else if StringCompare(fromModem, 'USY') = true then
                    begin
                        HangUp;
                        Redials := Redials + 1;
                        if Redials > MaxRedials then
                            begin
                                Redials := 0;
                                TotalBusy := TotalBusy + 1;
                                DumpToFile('Number busy');
                                NextNumber;
                            end;
                        Status := dialing;
                        DrawMainWindow;
                    end
                else if StringCompare(fromModem, 'O DIALTON') = true then
                    begin
                        HangUp;
                        doError(9);
                        Status := dialing;
                        DrawMainWindow;
                    end
                else if StringCompare(fromModem, 'RROR') = true then
                    begin
                        TotalErrors := TotalErrors + 1;
                        DumpToFile('Error');
                        NextNumber;
                    end;
            end
        else
            begin
                HangUp;
                TotalNoAnswer := TotalNoAnswer + 1;
                NextNumber;
            end;
    end;

{------------------------------- Menus & Keys ------------------------}
    procedure DoMenuSelection (MousePosition: Point);
        var
            MenuSelection: longint;
            MenuID, MenuItem: integer;
            dummy: boolean;
    begin
        MenuSelection := MenuSelect(MousePosition);
        MenuID := HiWord(MenuSelection);
        MenuItem := LoWord(MenuSelection);
        case MenuID of
            myAboutMenuID:
                if MenuItem = 1 then
                    ShowAboutWindow;
            myFileMenuID:
                if MenuItem = 1 then
                    dummy := GetFilename(true)
                else if MenuItem = 2 then
                    Quit := true
                else
                    doError(4);
            myOptionsMenuID:
                if MenuItem = 1 then
                    SelectPhoneNumber
                else if MenuItem = 2 then
                    SelectPrefs
                else
                    doError(4);
            otherwise
        end;
        HiliteMenu(0);
    end;

    procedure DoKeyEvent (TheKey: char);
    begin
        case TheKey of
            'q', 'Q':
                Quit := true;
            otherwise
        end;
        HiliteMenu(0);
    end;

    procedure DoMouseEvent (theEvent: EventRecord);
        var
            MouseWhere: integer;
            WindowSelected: WindowPtr;
            tempPt: point;
    begin
        MouseWhere := FindWindow(theEvent.where, WindowSelected);
        case MouseWhere of
            inMenuBar:
                DoMenuSelection(theEvent.where);
            inGoAway:
                if WindowSelected = MainWindow then
                    if TrackGoAway(MainWindow, theEvent.where) then
                        Quit := true;
            inDrag:
                DragWindow(MainWindow, theEvent.where, screenbits.bounds);
            inGrow, inContent:
                begin
                    tempPt := theEvent.where;
                    GlobalToLocal(tempPt);
                    if TestControl(myStartButton, tempPt) > 0 then
                        begin
                            if TrackControl(myStartButton, tempPt, nil) > 0 then
                                begin
                                    Status := dialing;
                                    Active := true;
                                    DrawMainWindow;
                                end;
                        end
                    else if TestControl(myStopButton, tempPt) > 0 then
                        begin
                            if TrackControl(myStopButton, tempPt, nil) > 0 then
                                begin
                                    HangUp;
                                    Status := idle;
                                    StartTime := '00:00';
                                    StopTime := '00:00';
                                    Active := false;
                                    DrawMainWindow;
                                end;
                        end;
                end;
            otherwise
        end;
    end;

{------------------------------- Main --------------------------------}
begin
    InitialiseVars;
    if not (SetupMenuBar) then
        doError(1)
    else
        begin
            if not (SetupWindows) then
                doError(2)
            else
                begin
                    if GetFilename(false) then
                        begin
                            SetupDrivers;
                            DrawMainWindow;
                            while not (Quit) do
                                begin
                                    if waitNextEvent(everyEvent, myEventRecord, 10, nil) then
                                        case myEventRecord.what of
                                            mouseDown:
                                                DoMouseEvent(MyEventRecord);
                                            updateEvt:
                                                begin
                                                    BeginUpdate(MainWindow);
                                                    SetPort(MainWindow);
                                                    SelectWindow(MainWindow);
                                                    DrawMainWindow;
                                                    EndUpdate(MainWindow);
                                                    SetCursor(Arrow);
                                                end;
                                            keyDown, autoKey:
                                                if BAND(MyEventRecord.modifiers, CmdKey) <> 0 then
                                                    DoKeyEvent(chr(MyEventRecord.message mod 256));
                                            otherwise
                                        end;
                                    CheckTimer;
                                    if Active then
                                        case Status of
                                            dialing:
                                                DialNumber;
                                            waiting:
                                                DoSerial;
                                            otherwise
                                        end;
                                end;
                            HangUp;
                            ClearInputBuffer;
                            CloseDrivers;
                            CloseResultFile;
                        end;
                end;
            KillWindows;
        end;
    KillMenuBar;
end.


{    Well, that's about the size of it!                                                                                 }
{    now onto the known errors:                                                                                        }
{    1)    I have problems hanging up the line.  I used to just shutdown the drivers then open them up again    }
{        This is somewhat bad method I think, but then if it works its fine by me.  I now send +++ followed    }
{        by a delay then ATH0 (Hayes commands).    This doesn't always work, depending upon the modem.    }
{        I tried it on a SupraFax modem and it worked, didn't like the Miracom though...try it anyway        }
{    2)    I also have problems getting things to background properly.  They work and all that but they         }
{        sometimes halt (least thats what it seems like to me) and when brought to the foreground carry        }
{        on quite happily.  Maybe I need to check the switches in the SIZE resource.  I have the CAN B'GND    }
{        switch set and I use waitNextEvent and all that but still things go awry - makes it more fun!            }
{                                                                                                                        }
{    Only 2 but they are the most prominent.  This may seem bad (it IS bad) but doesn't always happen        }
{    Oh yeah, I never support the apple menu properly (da's and stuff).  I just can't me bothered.                }
{    I know HOW to but I just haven't written the routine - its only a few lines but never got round to it.        }
{    If you want me to develop this stuff then mail me and I will get it working properly but in the            }
{    meantime this stuff will suffice.  If nothing else, its worth having for the serial code examples            }
{                                                                                                                                                            }
{    ALSO - in the resource file there is a template for hfdr...switch on baloons and point to S&DIII application    }
{                                                                                                                        }
{    Lots of Peace, Love and Good Happiness Stuff                                                                    }
{    Boris                                                                                                                }
{    BorMak Tech                                                                                                        }
{    Software and Network Consultants                                                                                }